! bool, string: rank-0
! integer     : rank-0, 1
! real        : rank-0, 1, 2

! get_value(l, x, name, index): rank-0, 1, 2

module easy_lua_m

    use, intrinsic :: iso_fortran_env, only: sp => real32, dp => real64
    use lua, only: lua_getglobal, lua_istable, lua_pop, &
                   lua_isboolean, lua_toboolean, lua_isstring, lua_tostring, &
                   lua_isinteger, lua_tointeger, lua_isnumber, lua_tonumber, &
                   lua_rawgeti, lua_rawlen
    use, intrinsic :: iso_c_binding, only: c_ptr
    implicit none
    private

    public :: get_value

    interface get_value !! 从lua获取值
        procedure :: get_value_int, get_value_sp, get_value_dp, get_value_string, get_value_bool
        procedure :: get_value_int_1, get_value_sp_1, get_value_dp_1
        procedure :: get_value_sp_2, get_value_dp_2
    end interface get_value

contains

    subroutine get_value_int(l, x, name, index)
        type(c_ptr), intent(in) :: l
        integer, intent(out) :: x
        character(len=*), intent(in), optional :: name
        integer, intent(in), optional :: index
        integer index_, rc
        
        if (present(index)) then
            index_ = index
        else
            index_ = -1
        end if
        if (present(name)) rc = lua_getglobal(l, name)
        if (lua_isinteger(l, index_) == 1) then
            x = lua_tointeger(l, index_)
        else
            error stop "Non-integer type to integer type"
        end if
    end subroutine get_value_int

    subroutine get_value_sp(l, x, name, index)
        type(c_ptr), intent(in) :: l
        real(sp), intent(out) :: x
        character(len=*), intent(in), optional :: name
        integer, intent(in), optional :: index
        real(dp) x_
        call get_value_dp(l, x_, name, index)
        x = real(x_, sp)
    end subroutine get_value_sp

    subroutine get_value_dp(l, x, name, index)
        type(c_ptr), intent(in) :: l
        real(dp), intent(out) :: x
        character(len=*), intent(in), optional :: name
        integer, intent(in), optional :: index
        integer index_, rc
        if (present(index)) then
            index_ = index
        else
            index_ = -1
        end if
        if (present(name)) rc = lua_getglobal(l, name)
        if (lua_isnumber(l, index_) == 1) then
            x = lua_tonumber(l, index_)
        else
            error stop "Non-number type to number type"
        end if
    end subroutine get_value_dp

    subroutine get_value_string(l, x, name, index)
        type(c_ptr), intent(in) :: l
        character(len=:), allocatable, intent(out) :: x
        character(len=*), intent(in), optional :: name
        integer, intent(in), optional :: index
        integer index_, rc
        if (present(index)) then
            index_ = index
        else
            index_ = -1
        end if
        if (present(name)) rc = lua_getglobal(l, name)
        if (lua_isstring(l, index_) == 1) then
            x = lua_tostring(l, index_)
        else
            error stop "Non-string type to string type"
        end if
    end subroutine get_value_string

    subroutine get_value_bool(l, x, name, index)
        type(c_ptr), intent(in) :: l
        logical, intent(out) :: x
        character(len=*), intent(in), optional :: name
        integer, intent(in), optional :: index
        integer index_, rc
        if (present(index)) then
            index_ = index
        else
            index_ = -1
        end if
        if (present(name)) rc = lua_getglobal(l, name)
        if (lua_isboolean(l, index_) == 1) then
            x = lua_toboolean(l, index_)
        else
            error stop "Non-boolean type to boolean type"
        end if
    end subroutine get_value_bool

    subroutine get_value_int_1(l, x, name, index)
        type(c_ptr), intent(in) :: l
        integer, intent(out), allocatable :: x(:)
        character(len=*), intent(in), optional :: name
        integer, intent(in), optional :: index
        integer rc, len, i, index_

        if (present(index)) then
            index_ = index
        else
            index_ = -1
        end if
        if (present(name)) rc = lua_getglobal(l, name)
        if (lua_istable(l, index_) == 1) then
            len = lua_rawlen(l, index_)
            if (len > 0) then
                allocate (x(len))
                do i = 1, len
                    rc = lua_rawgeti(l, index_, i)
                    if (lua_isinteger(l, -1) == 1) then
                        x(i) = lua_tointeger(l, -1)
                    else
                        error stop "Non-integer type to integer type"
                    end if
                    call lua_pop(l, 1)
                end do
            end if
        else
            error stop "Non-table type to table type"
        end if
    end subroutine get_value_int_1

    subroutine get_value_sp_1(l, x, name, index)
        type(c_ptr), intent(in) :: l
        real(sp), intent(out), allocatable :: x(:)
        character(len=*), intent(in), optional :: name
        integer, intent(in), optional :: index
        real(dp), allocatable :: x_(:)
        call get_value_dp_1(l, x_, name, index)
        x = real(x_, sp)
    end subroutine get_value_sp_1

    subroutine get_value_dp_1(l, x, name, index)
        type(c_ptr), intent(in) :: l
        character(len=*), intent(in), optional :: name
        integer, intent(in), optional :: index
        real(dp), intent(out), allocatable :: x(:)
        integer rc, len, i, index_

        if (present(index)) then
            index_ = index
        else
            index_ = -1
        end if
        if (present(name)) rc = lua_getglobal(l, name)
        if (lua_istable(l, index_) == 1) then
            len = lua_rawlen(l, index_)
            if (len > 0) then
                allocate (x(len))
                do i = 1, len
                    rc = lua_rawgeti(l, index_, i)
                    if (lua_isnumber(l, -1) == 1) then
                        x(i) = lua_tonumber(l, -1)
                    else
                        error stop "Non-number type to number type"
                    end if
                    call lua_pop(l, 1)
                end do
            end if
        else
            error stop "Non-table type to table type"
        end if
    end subroutine get_value_dp_1

    subroutine get_value_sp_2(l, x, name, index)
        type(c_ptr), intent(in) :: l
        real(sp), intent(out), allocatable :: x(:, :)
        character(len=*), intent(in), optional :: name
        integer, intent(in), optional :: index
        real(dp), allocatable :: x_(:, :)
        call get_value_dp_2(l, x_, name, index)
        x = real(x_, sp)
    end subroutine get_value_sp_2

    subroutine get_value_dp_2(l, x, name, index)
        type(c_ptr), intent(in) :: l
        real(dp), intent(out), allocatable :: x(:, :)
        character(len=*), intent(in), optional :: name
        integer, intent(in), optional :: index
        integer rc, lenx, leny, i, j, index_

        if (present(name)) rc = lua_getglobal(l, name)
        if (present(index)) then
            index_ = index
        else
            index_ = -1
        end if

        if (lua_istable(l, index_) == 1) then
            lenx = lua_rawlen(l, index_)
        else
            error stop "Non-table type to table type"
        end if
        rc = lua_rawgeti(l, index_, 1)
        if (lua_istable(l, -1) == 1) then
            leny = lua_rawlen(l, -1)
        else
            error stop "Non-table type to table type"
        end if
        if (present(name)) then
            rc = lua_getglobal(l, name)
            rc = lua_rawgeti(l, index_, 1) ! get the first row
        end if
        if (lenx > 0 .and. leny > 0) then
            allocate (x(lenx, leny))
            do i = 1, lenx
                if (i /= 1) rc = lua_rawgeti(l, index_, i) ! Hack to get the other rows, not the first
                do j = 1, leny
                    rc = lua_rawgeti(l, -1, j)
                    if (lua_isnumber(l, -1) == 1) then
                        x(i, j) = lua_tonumber(l, -1)
                    else
                        error stop "Non-number type to number type"
                    end if
                    call lua_pop(l, 1)
                end do
                call lua_pop(l, 1)
            end do
        end if
    end subroutine get_value_dp_2

end module easy_lua_m
